Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/afsock_1/afsock~1.exe/Mailer/MailMessage.cls

Visual Basic class definition | 1999-01-01 | 6.6 KB | 228 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MailMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Dim AFS As New AFSOCKETLib.Socket

Dim mLastError As String

'local variable(s) to hold property value(s)
Private mvarSubject As String 'local copy
Private mvarBody As String 'local copy
Private mvarSent As Date 'local copy
Private mvarReceived As Date 'local copy
'local variable(s) to hold property value(s)
Private mvarReceivers As Addressees 'local copy
Private mvarSenders As Addressees 'local copy
'local variable(s) to hold property value(s)
Private mvarMailer As String 'local copy
'local variable(s) to hold property value(s)
Private mvarMailServer As String 'local copy
Public Property Let MailServer(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MailServer = 5
    mvarMailServer = vData
End Property


Public Property Get MailServer() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.MailServer
    MailServer = mvarMailServer
End Property


Public Property Let Mailer(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Mailer = 5
    mvarMailer = vData
End Property

Public Property Get Mailer() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Mailer
    Mailer = mvarMailer
End Property

Public Sub Clear()
  Set mvarReceivers = New Addressees 'local copy
  Set mvarSenders = New Addressees  'local copy
  mvarSubject = ""
  mvarBody = ""
  mvarSent = Now
  mvarReceived = Now
End Sub

Public Property Set Senders(ByVal vData As Addressees)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.Senders = Form1
    Set mvarSenders = vData
End Property

Public Property Get Senders() As Addressees
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Senders
    Set Senders = mvarSenders
End Property

Public Property Set Receivers(ByVal vData As Addressees)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.Receivers = Form1
    Set mvarReceivers = vData
End Property

Public Property Get Receivers() As Addressees
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Receivers
    Set Receivers = mvarReceivers
End Property


Public Function Submit() As Boolean

On Error GoTo exitSubmit

  If Not Connect(mvarMailServer) Then
    mLastError = "mail server not found. e# " & AFS.LastError
    Exit Function
  End If
  WaitResponse "220"
  SendCommand "HELO"
  WaitResponse "250"
  SendCommand "MAIL FROM:" & mvarSenders.Item(1).EMail
  WaitResponse "250"

  Dim A As Addressee
  For Each A In mvarReceivers
    SendCommand "RCPT TO:" & A.EMail
    WaitResponse "250"
  Next
  SendCommand "DATA"
  WaitResponse "354"

  SendCommand "From: """ & mvarSenders.Item(1).Person & """ <" & mvarSenders.Item(1).EMail & ">"
  For Each A In mvarReceivers
    SendCommand "To: """ & A.Person & """ <" & A.EMail & ">"
  Next
  SendCommand "Subject:" & mvarSubject
  SendCommand "Date: " & Format$(mvarSent, "ddd, dd mmm yyyy h:mm:ss") & "+0300"
  SendCommand "MIME-Version: 1.0"
  SendCommand "Content-Type: text/plain; Charset = ""Windows-1252"""
  SendCommand "Content-Transfer-Encoding: 8bit"
  SendCommand "X-Priority: 3"
  SendCommand "X-Mailer: " & mvarMailer
  SendCommand ""
  SendCommand mvarBody
  SendCommand ""
  SendCommand "."
  'WaitResponse "250"
  'SendCommand "QUIT"
  WaitResponse "250"
  Submit = True
exitSubmit:
  mLastError = Err.Description
  Exit Function
End Function

Public Property Let Received(ByVal vData As Date)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Received = 5
    mvarReceived = vData
End Property

Public Property Get Received() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Received
    Received = mvarReceived
End Property

Public Property Let Sent(ByVal vData As Date)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Sent = 5
    mvarSent = vData
End Property

Public Property Get Sent() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Sent
    Sent = mvarSent
End Property

Public Property Let Body(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Body = 5
    mvarBody = vData
End Property

Public Property Get Body() As String
Attribute Body.VB_UserMemId = 0
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Body
    Body = mvarBody
End Property

Public Property Let Subject(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Subject = 5
    mvarSubject = vData
End Property


Public Property Get Subject() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Subject
    Subject = mvarSubject
End Property

Private Sub Class_Initialize()
  Set mvarReceivers = New Addressees 'local copy
  Set mvarSenders = New Addressees  'local copy
End Sub

Private Function Connect(ByVal MailServer$)
  Connect = AFS.Connect(MailServer, 25)
End Function

Public Sub SendCommand(S As String)
  AFS.Send S & vbCrLf
End Sub

Public Sub WaitResponse(ByVal Resp$, Optional ByVal BadResp$)
  Dim InputData$
  InputData = AFS.Receive(10000)
  If InputData <> "" Then
    If Len(BadResp) <> 0 Then
       If InStr(1, InputData, BadResp) <> 0 Then GoTo BadExit
    End If
    If InStr(1, InputData, Resp) <> 0 Then GoTo NormalExit
  Else
    Err.Raise 20000, "WaitResponse", "Timeout"
  End If
  Exit Sub
NormalExit:
  'Debug.Print InputData
  Exit Sub
BadExit:
  Err.Raise 20000, "WaitResponse", BadResp
  Exit Sub
End Sub


Public Property Get LastError() As String
  LastError = mLastError
End Property